home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / ownrdr.exe / SAMPLAPP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-02-04  |  3.0 KB  |  123 lines
  1. program samplapp;
  2. {$R samplapp.RES}
  3.  
  4. uses WObjects, WinTypes, WinProcs, Strings, WinDos, Ownrdraw;
  5.  
  6. type
  7.   TMyApp = object(TApplication)
  8.     procedure InitInstance; virtual;
  9.     procedure InitMainWindow; virtual;
  10.   end;
  11.  
  12.   TAboutDialog = object (TOwnerDialog)
  13.     constructor Init (AParent : PWindowsObject; AName : PChar);
  14.     procedure Ok (var Msg : TMessage); virtual id_First+1;
  15.     procedure Cancel (var Msg : TMessage); virtual id_First+2;
  16.   end;
  17.  
  18.   PMyWindow = ^TMyWindow;
  19.   TMyWindow = object(TWindow)
  20.     constructor Init (ATitle : PChar);
  21.     procedure SetupWindow ; virtual;
  22.     function GetClassName : PChar; virtual;
  23.     procedure GetWindowClass (var AWndClass : TWndClass); virtual;
  24.     Procedure AboutChoice (var Msg : TMessage); virtual cm_First + 100;
  25.     Procedure ExitChoice (var Msg : TMessage); virtual cm_First + 102;
  26.     destructor Done; virtual;
  27.   end;
  28.  
  29. constructor TAboutDialog.Init (AParent : PWindowsObject; AName : PChar);
  30. begin
  31.   TOwnerDialog.Init (AParent, AName);
  32.   NewButton (1, True);  { Ok Button ID is default button }
  33.   NewButton (2, False); { Cancel Button ID is not default button }
  34. end;
  35.  
  36. procedure TAboutDialog.Ok (var Msg : TMessage);
  37. begin
  38.   MessageBox (HWindow, 'Ok Button pressed.', 'Button Pushed!', mb_IconInformation or mb_Ok);
  39.   TOwnerDialog.Ok (Msg);  { Call parent Ok Button method }
  40. end;
  41.  
  42. procedure TAboutDialog.Cancel (var Msg : TMessage);
  43. begin
  44.   MessageBox (HWindow, 'Cancel Button pressed.', 'Button Pushed!', mb_IconInformation or mb_Ok);
  45.   TOwnerDialog.Cancel (Msg);
  46. end;
  47.  
  48. {-------TMyWindow.Init}
  49. constructor TMyWindow.Init(ATitle : PChar);
  50. begin
  51.   TWindow.Init(Nil, ATitle);
  52.   with Attr do
  53.     begin
  54.       Style := ws_OverlappedWindow;
  55.       Menu := LoadMenu(hInstance, 'MAINMENU');
  56.     end;
  57. end;
  58.  
  59. {-------TMyWindow.SetupWindow;}
  60. procedure TMyWindow.SetupWindow;
  61. begin
  62.   TWindow.SetupWindow;
  63. end;
  64.  
  65. {-------TMyWindow.GetClassName}
  66. function TMyWindow.GetClassName : PChar;
  67. begin
  68.   GetClassName := 'SAMPLAPP';
  69. end;
  70.  
  71. {-------TMyWindow.GetWindowClass}
  72. procedure TMyWindow.GetWindowClass(var AWndClass : TWndClass);
  73. begin
  74.   TWindow.GetWindowClass(AWndClass);
  75.   with AWndClass do
  76.     begin
  77.       hCursor := LoadCursor(0, PChar(idc_Arrow));
  78.       hIcon := LoadIcon(0, PChar(idi_Application));
  79.       Style := cs_Vredraw or cs_Hredraw;
  80.     end;
  81. end;
  82.  
  83. Procedure TMyWindow.AboutChoice (var Msg : TMessage);
  84. var Dialog : TAboutDialog;
  85.  
  86. begin
  87.   Dialog.Init (@Self, 'ABOUT');
  88.   Dialog.Execute;
  89.   Dialog.Done;
  90. end;
  91.  
  92. Procedure TMyWindow.ExitChoice(var Msg : TMessage);
  93. begin
  94.   PostQuitMessage (0);
  95. end;
  96.  
  97. {------TMyWindow.Done}
  98. destructor TMyWindow.Done;
  99. begin
  100.   TWindow.Done;
  101. end;
  102.  
  103. {------TMyApp.InitMainWindow}
  104. procedure TMyApp.InitMainWindow;
  105. begin
  106.   MainWindow := New(PMyWindow, Init('Owner Draw Buttons Demo'));
  107. end;
  108.  
  109. {------TMyApp.InitInstance}
  110. procedure TMyApp.InitInstance;
  111. begin
  112.   TApplication.InitInstance;
  113.   hAccTable := 0;
  114. end;
  115.  
  116. var
  117.   App : TMyApp;
  118. begin
  119.   App.Init('MyWindow');
  120.   App.Run;
  121.   App.Done;
  122. end.
  123.